home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Pd / mweg.e < prev    next >
Encoding:
Text File  |  1994-12-01  |  7.3 KB  |  257 lines
  1. MODULE 'exec/nodes', 'exec/ports',
  2.        'intuition/intuition',
  3.        'gadtools', 'libraries/gadtools'
  4.  
  5. ENUM ER_NONE, ER_NOGT, ER_NOSCRN, ER_NOVISUAL, ER_NOMENUS, ER_NOINITWIN
  6.  
  7. ENUM CM_NONE,
  8.      CM_NEW, CM_QUIT,
  9.      CM_NEXT, CM_PREV, CM_ZOOM, CM_BACK, CM_FRONT, CM_CLOSE
  10.  
  11. OBJECT wininfolist
  12.   head:     LONG
  13.   tail:     LONG
  14.   tailpred: LONG
  15. ENDOBJECT
  16.  
  17. OBJECT wininfo
  18.   succ:     LONG
  19.   pred:     LONG
  20.   winptr:   LONG
  21. ENDOBJECT
  22.  
  23. DEF winlist: PTR TO wininfolist, /* liste liées des fenêtres       */
  24.     menuptr = NIL: PTR TO menu,  /* menus construit par GadTools   */
  25.     scr = NIL,                   /* pointer sur l'écran par défaut */
  26.     visual = NIL                 /* pointer sur VisualInfo         */
  27.  
  28. /* Affiche une erreur en utilisant EasyRequest */
  29. PROC errmsg(msgptr)
  30.   EasyRequestArgs(0, [20, 0, 'Erreur', msgptr, 'OK'], 0, 0)
  31. ENDPROC
  32.  
  33. /* Ouvre une nouvelle fenêtre */
  34. PROC openwin()
  35.   DEF wi: PTR TO wininfo, w: PTR TO window,
  36.       success = FALSE
  37.  
  38.   /* Prend un peu de mémoire pour les noeuds */
  39.   wi := New(SIZEOF wininfo)
  40.  
  41.   IF wi
  42.     IF (w := OpenWindowTagList(NIL,
  43.       [WA_LEFT, Rnd(300), WA_TOP, Rnd(100),
  44.        WA_WIDTH,    340, WA_HEIGHT,    156,
  45.        WA_MINWIDTH, 160, WA_MINHEIGHT,  70,
  46.        WA_MAXWIDTH,  -1, WA_MAXHEIGHT,  -1,
  47.        WA_TITLE, 'A window',
  48.        WA_FLAGS, WFLG_SIMPLE_REFRESH OR WFLG_ACTIVATE OR WFLG_DRAGBAR OR
  49.                  WFLG_CLOSEGADGET OR WFLG_DEPTHGADGET OR WFLG_SIZEGADGET,
  50.        WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_MENUPICK,
  51.        WA_SCREENTITLE, 'Exemple de Multi-dfenêtre par David Higginson',
  52.        NIL, NIL])) = NIL
  53.       errmsg('Ne peut pas ouvrir de fenêtre.')
  54.       Dispose(wi)
  55.     ELSE
  56.       IF SetMenuStrip(w, menuptr)
  57.         wi.winptr := w
  58.         success := TRUE
  59.       ELSE
  60.         CloseWindow(w)
  61.         Dispose(wi)
  62.         errmsg('Ne peut pas attacher de menus à la fenêtre.')
  63.       ENDIF
  64.     ENDIF
  65.   ELSE
  66.     errmsg('Plus de mémoire.')
  67.   ENDIF
  68.  
  69.   /* Fait y le lien */
  70.   IF success THEN AddHead(winlist, wi)
  71.   /* N.B. Les nouveaux noeuds DOIVENT être attachés à la tte (head) de la liste */
  72. ENDPROC success
  73.  
  74. PROC cm_new()
  75.   IF openwin() = FALSE THEN errmsg('Ne peut pas ouvrir la fenêtre.')
  76. ENDPROC
  77.  
  78. PROC cm_next(wi: PTR TO wininfo)
  79.   wi := wi.succ
  80.   IF wi.succ = FALSE THEN wi := winlist.head
  81.   IF wi.succ THEN ActivateWindow(wi.winptr)
  82. ENDPROC
  83.  
  84. PROC cm_prev(wi: PTR TO wininfo)
  85.   wi := wi.pred
  86.   IF wi.pred = FALSE THEN wi := winlist.tailpred
  87.   IF wi.pred THEN ActivateWindow(wi.winptr)
  88. ENDPROC
  89.  
  90. /* Prépare bibliothèques, écrans, menus */
  91. PROC setup()
  92.   /* Ouvre la gadtools.library */
  93.   IF (gadtoolsbase := OpenLibrary('gadtools.library', 37)) = NIL THEN
  94.     Raise(ER_NOGT)
  95.  
  96.   /* Prépare la liste pour prendre les infos des fenêtres */
  97.   winlist := [0, 0, 0]
  98.   winlist.head := Mul(winlist + 4,1)
  99.   winlist.tailpred := winlist
  100.  
  101.   /* Prend l'écran par défaut et les visualinfo */
  102.   IF (scr := LockPubScreen(NIL)) = NIL THEN Raise(ER_NOSCRN)
  103.   IF (visual := GetVisualInfoA(scr, NIL)) = NIL THEN Raise(ER_NOVISUAL)
  104.  
  105.   /* Crée les menus */
  106.   IF (menuptr := CreateMenusA([NM_TITLE, 0, 'Projet', 0, 0, 0, 0,
  107.     NM_ITEM, 0, 'Nouveau...',           'N', 0, 0, CM_NEW,
  108.     NM_ITEM, 0, NM_BARLABEL,         0 , 0, 0, 0,
  109.     NM_ITEM, 0, 'Quitter',             'Q', 0, 0, CM_QUIT,
  110.     NM_TITLE, 0, 'Fenêtre',           0 , 0, 0, 0,
  111.     NM_ITEM, 0, 'Suivante',             ',', 0, 0, CM_NEXT,
  112.     NM_ITEM, 0, 'Précédente',         '.', 0, 0, CM_PREV,
  113.     NM_ITEM, 0, NM_BARLABEL,         0 , 0, 0, 0,
  114.     NM_ITEM, 0, 'Zoom',             'Z', 0, 0, CM_ZOOM,
  115.     NM_ITEM, 0, NM_BARLABEL,         0 , 0, 0, 0,
  116.     NM_ITEM, 0, 'Mettre devant',   '>', 0, 0, CM_FRONT,
  117.     NM_ITEM, 0, 'Mettre derrière',     '<', 0, 0, CM_BACK,
  118.     NM_ITEM, 0, NM_BARLABEL,         0 , 0, 0, 0,
  119.     NM_ITEM, 0, 'Fermer',            'K', 0, 0, CM_CLOSE,
  120.     NM_END, 0, 0, 0, 0, 0, 0]:newmenu, NIL)) = NIL THEN Raise(ER_NOMENUS)
  121.  
  122.   IF LayoutMenusA(menuptr, visual, NIL) = FALSE THEN Raise(ER_NOMENUS)
  123.  
  124.   /* Ouvre la fenêtre initiale */
  125.   IF openwin() = FALSE THEN Raise(ER_NOINITWIN)
  126. ENDPROC
  127.  
  128. /* Attend les messages */
  129. PROC eventloop()
  130.   DEF quit = FALSE,
  131.       msg: PTR TO intuimessage, class,
  132.       sig, bitmask, recalc_bitmask = TRUE,
  133.       close_this_win,
  134.       wi: PTR TO wininfo, tempwi: PTR TO wininfo,
  135.       w: PTR TO window, u: PTR TO mp,
  136.       item: PTR TO menuitem, code, id
  137.  
  138.   REPEAT
  139.     /* Recalcule le masque formé par les tous les sigbits OR */
  140.     IF recalc_bitmask
  141.       bitmask := 0
  142.       wi := winlist.head
  143.       WHILE wi.succ
  144.         w := wi.winptr
  145.         u := w.userport
  146.         bitmask := bitmask OR Shl(1,u.sigbit)
  147.         wi := wi.succ
  148.       ENDWHILE
  149.     ENDIF
  150.  
  151.     /* Attend que quelqchose se passe */
  152.     sig := Wait(bitmask)
  153.  
  154.     /* maintenant teste tous les sigbits des fenetres */
  155.     wi := winlist.head
  156.     WHILE wi.succ
  157.       tempwi := wi.succ
  158.       w := wi.winptr
  159.       u := w.userport
  160.       IF sig AND Shl(1,u.sigbit)
  161.         /* Message(s) reçue par cette fenêtre */
  162.  
  163.         close_this_win := FALSE
  164.  
  165.         WHILE u
  166.           IF msg:=GetMsg(u)
  167.             class := msg.class
  168.             code := MENUNULL
  169.  
  170.             SELECT class
  171.  
  172.               CASE IDCMP_CLOSEWINDOW
  173.                 /* l'utilisateur à choisit le gadget de fermeture */
  174.                 /* Ne peut la fezrmer maintenant car le msgport disparaitrait */
  175.                 close_this_win := TRUE
  176.  
  177.               CASE IDCMP_MENUPICK
  178.                 code := msg.code
  179.  
  180.             ENDSELECT
  181.  
  182.             ReplyMsg(msg)
  183.  
  184.             /* Procède aux évèments menu après que le messages soit rendu (replied) */
  185.             WHILE code <> MENUNULL
  186.               item := ItemAddress(menuptr, code)
  187.               IF item
  188.                 id := Long(item + 34)
  189.                 SELECT id
  190.                   CASE CM_NEW;    cm_new()
  191.                   CASE CM_QUIT;   quit := TRUE
  192.                   CASE CM_NEXT;   cm_next(wi)
  193.                   CASE CM_PREV;   cm_prev(wi)
  194.                   CASE CM_ZOOM;   IF w THEN ZipWindow(w)
  195.                   CASE CM_FRONT;  IF w THEN WindowToFront(w)
  196.                   CASE CM_BACK;   IF w THEN WindowToBack(w)
  197.                   CASE CM_CLOSE;  close_this_win := TRUE
  198.                 ENDSELECT
  199.                 code := item.nextselect
  200.               ELSE
  201.                 code := MENUNULL
  202.               ENDIF
  203.             ENDWHILE
  204.  
  205.             IF close_this_win
  206.               recalc_bitmask := TRUE
  207.  
  208.               ClearMenuStrip(w)
  209.               CloseWindow(w)
  210.               Remove(wi)
  211.               Dispose(wi)
  212.  
  213.               IF winlist.tailpred = winlist THEN quit := TRUE
  214.               u := NIL
  215.  
  216.             ENDIF
  217.           ELSE
  218.             u := NIL /* Plus d'autre message */
  219.           ENDIF
  220.         ENDWHILE
  221.       ENDIF
  222.  
  223.       wi := tempwi
  224.  
  225.     ENDWHILE
  226.  
  227.   UNTIL quit
  228. ENDPROC
  229.  
  230. PROC shutdown()
  231.   DEF wi: PTR TO wininfo
  232.   WHILE wi := RemTail(winlist)
  233.     ClearMenuStrip(wi.winptr)
  234.     CloseWindow(wi.winptr)
  235.     Dispose(wi)
  236.   ENDWHILE
  237.   FreeMenus(menuptr)
  238.   FreeVisualInfo(visual)
  239.   UnlockPubScreen(scr, NIL)
  240.   CloseLibrary(gadtoolsbase)
  241. ENDPROC
  242.  
  243. PROC main() HANDLE
  244.   DEF erlist:PTR TO LONG
  245.   setup()
  246.   eventloop()
  247.   Raise(ER_NONE)
  248. EXCEPT
  249.   shutdown()
  250.   erlist := ['Ce program a besoin de la gadtools.library.',
  251.              'Ne peut pas trouver l'écran public.',
  252.              'Ne peut pas prendre les visual info pour l'écran.',
  253.              'Ne peut pas créer les menus.',
  254.              'Ne peut pas créer la fenêtre initiale.']
  255.   IF exception>0 THEN errmsg(erlist[exception - 1])
  256. ENDPROC
  257.